{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  HydroChecks
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Checkers for pump controllers
-- 
-- Note - these checks aren\'t universal - they are bad smells
-- only for the sample dataset and the use case of the 
-- controllers therein.
--
--------------------------------------------------------------------------------

module HydroChecks
  ( 
    HydroPriority(..)
  , HydroGroup
  , HydroChecker

  -- Quick Start
  , quickstart_group
  , mode_is_level
  , material_liquid_or_nothing
  , unit_is_meters
  , empty_distance_gt_span
  , blanking_distance

  -- Relays
  , relay_group
  , nodup_relays
  , count_relays

  -- Pump control
  , pumpcontrol_group
  , off_setpoints_below_on_setpoints

  -- LOE
  , loe_group
  , last_relay_is_loe
  , singleton_loe


  ) where

import HydroConfig

import ConfigCheck.Checker

import Control.Applicative
import Data.Function
import Data.List ( nub )



data HydroPriority = PFAIL | PWARN
  deriving (Enum,Eq,Ord,Show)

instance Priority HydroPriority where
  priorityName PFAIL = "Fail"
  priorityName PWARN = "Warning"

type HydroGroup = CheckerGroup HydroPriority HydroConfig

type HydroChecker = Checker HydroPriority HydroConfig

--
-- old-style = HYDRORANGER, MULTIRANGER_PLUS
-- new-style = HYDRORANGER 200, HYDRORANGER_PLUS
--
-- It is a good naming convention to prefix Boolean tests with 
-- _is_ - see Data.Char
--

isNewStyle :: SensorType -> Bool
isNewStyle = relaysFrom111



toDouble :: RealFrac a => a -> Double
toDouble = realToFrac


--------------------------------------------------------------------------------
-- So called /Quick Start/ params

quickstart_group :: HydroGroup
quickstart_group = CheckerGroup
    { group_name          = "Quick Start"
    , group_checker_specs = [ mode_is_level
                            , material_liquid_or_nothing
                            , unit_is_meters
                            , empty_distance_gt_span
                            , blanking_distance
                            ]
    }


mode_is_level :: HydroChecker
mode_is_level = 
    let desc = "All pump controllers should operate in Level mode \
               \(i.e. how full a vessel is)."
    in Checker
      { checker_name        = "Mode should be LEVEL"
      , checker_description = desc
      , checker_priority    = PFAIL
      , checker_code        = code
      }
  where
    errk  = errMsg1 "Mode is %s" . show
    -- Note - self is entirely cosmetic...
    code  = focus (self >>> sensor >>> sensor_mode) $ 
               selftest (==MODE_LEVEL) errk



material_liquid_or_nothing :: HydroChecker
material_liquid_or_nothing = 
    let desc = "New style controllers (Hydro+, Hydro 200) should have \
               \the Material field set to LIQUID. \
               \Old style controllers (Hydroranger, Multiranger Plus) \
               \should not have a Material field. \
               \[NOTE - Failure here most likely indicates a mistake \
               \in the data collection]."
    in Checker
      { checker_name        = "Material should be LIQUID"
      , checker_description = desc
      , checker_priority    = PFAIL
      , checker_code        = code
      }
  where                            
    errNew  = errMsg1 "Invalid material %s" . show
    errOld  = errMsg1 "Material (%s) specified for old style controller" . show
    code    = do { ty <- get (sensor >>> sensor_type)
                 ; annotate $ "Sensor type is " ++ show ty
                 ; focus (sensor >>> sensor_material) $ 
                     if isNewStyle ty 
                       then onlyJust $ selftest (== MATERIAL_LIQUID) errNew
                       else selftest (== Nothing) errOld
                 }


unit_is_meters :: HydroChecker
unit_is_meters = Checker
    { checker_name         = "Unit should be METERS"
    , checker_description  = "For global consistency always use meters."
    , checker_priority     = PWARN
    , checker_code         = code 
    }
  where
    errk = errMsg1 "Unit is %s" . show
    code = focus (sensor >>> sensor_original_units) $ selftest (==UNIT_METERS) errk



empty_distance_gt_span :: HydroChecker
empty_distance_gt_span = Checker
    { checker_name        = "Empty distance higher than span"
    , checker_description = "Empty distance should be higher than span."
    , checker_priority    = PFAIL
    , checker_code        = code
    }
  where
    errk = on (errMsg2 "Empty distance (%.2f) below span (%.2f)") toDouble
    code = focus sensor $
             assert2 (>) errk
                <$> get sensor_empty_distance <*> get sensor_span




-- Note - units should be normalized to meters before checking...
blanking_distance :: HydroChecker
blanking_distance = Checker
    { checker_name        = "Blanking distance"
    , checker_description = "Blanking distance is not 0.3 meters." 
    , checker_priority    = PFAIL
    , checker_code        = code
    }
  where
    errk = errMsg1 "Non-stardard blanking distance: %.2f" . toDouble
    code = focus sensor $  
             (\e s -> let b = e - s in assert (b == 0.3) (errk b))
                 <$> get sensor_empty_distance <*> get sensor_span



--------------------------------------------------------------------------------
-- Relay group

relay_group :: HydroGroup
relay_group = CheckerGroup
    { group_name          = "Relay"
    , group_checker_specs = [ nodup_relays, count_relays ]
    }


nodup_relays :: HydroChecker
nodup_relays = 
    let desc = "No relays params should be duplicated. \ 
               \Duplicated params may indicate previous settings not deleted \
               \when the controller was updated." 
    in Checker
      { checker_name        = "No duplicate relays"
      , checker_description = desc
      , checker_priority    = PWARN
      , checker_code        = checker
      }
  where
    checker = focus (sensor >>> relayList) $ selftest_ $ \xs -> 
                 let ys = filter (/= (UncalibRelay RELAY_NOT_IN_USE)) xs
                 in length ys == length (nub ys)


-- TODO - Better check might be no relays higher than max...
count_relays :: HydroChecker
count_relays = Checker
    { checker_name        = "Count relays"
    , checker_description = unwords $ 
        [ "The count of relays should not be greater than the number" 
        , "of relays the controller supports." 
        , "[NOTE - Failure here indicates a mistake in the data collection]."
        ]
    , checker_priority    = PWARN
    , checker_code        = checker
    }
  where
    checker = focus sensor $ 
                assert2 (>=) (\_ b -> errMsg1 "Too many relays: %i" b)
                     <$> get (sensor_type >>> relayCount)
                     <*> get (relayList >>> length)





-- groups for alarms...



--------------------------------------------------------------------------------
-- Pump control

pumpcontrol_group :: HydroGroup
pumpcontrol_group = CheckerGroup
    { group_name          = "PumpControl"
    , group_checker_specs = [ off_setpoints_below_on_setpoints ]
    }



-- | TODO - this is not pertinent for alarms...
--
-- Low alarms should be off > on
--
off_setpoints_below_on_setpoints :: HydroChecker
off_setpoints_below_on_setpoints = Checker
    { checker_name        = "Off below on"
    , checker_description = "Pump Off setpoints should be below On setpoints." 
    , checker_priority    = PFAIL
    , checker_code        = checker
    }
  where
    checker = focus (sensor >>> sensor_relays) $ checkall check1
    check1  = focus mbSetpoints $ whenJust $ selftest_ $ \(onn,off) -> onn > off



--------------------------------------------------------------------------------
-- LOE

loe_group :: HydroGroup
loe_group = CheckerGroup
    { group_name          = "LOE"
    , group_checker_specs = [ last_relay_is_loe, singleton_loe ]
    }


last_relay_is_loe :: HydroChecker
last_relay_is_loe = Checker
    { checker_name        = "Last relay LOE"
    , checker_description = "Last relay should be loss of echo." 
    , checker_priority    = PWARN
    , checker_code        = code
    }
  where
    code  = focus sensor $ do 
              { n <- get (sensor_type >>> relayCount)
              ; focus (sensor_relays) $ indexed n $ 
                  assert1 (== RELAY_LOSS_OF_ECHO) 
                          (\o -> "Not LOE: " ++ show o)
                     <$> get relay_function
              }



-- Don\'t use exactly as @last_relay_is_loe@ already finds no LOE
singleton_loe :: HydroChecker
singleton_loe = Checker 
    { checker_name        = "Singleton LOE"
    , checker_description = "Only one relay should monitor loss of echo." 
    , checker_priority    = PWARN
    , checker_code        = code
    }
  where
    code  = focus (sensor >>> sensor_relays) $ atmost 1 $ 
                assert1_ (== RELAY_LOSS_OF_ECHO)
                  <$> get relay_function

